home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PASCALL
/
CLOCKIN
/
CLOCK3.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-20
|
3KB
|
115 lines
program graphclock;
uses
graph,graphin3,dos,crt;
function printmonth(month:word):string;
begin
case month of
1: printmonth:='january';
2: printmonth:='february';
3: printmonth:='march';
4: printmonth:='april';
5: printmonth:='may';
6: printmonth:='june';
7: printmonth:='july';
8: printmonth:='august';
9: printmonth:='september';
10: printmonth:='october';
11: printmonth:='november';
12: printmonth:='december'
else exit;
end;
end;
function printdayofweek(day:word):string;
begin
case day of
0: printdayofweek:='sunday';
1: printdayofweek:='monday';
2: printdayofweek:='tuesday';
3: printdayofweek:='wednesday';
4: printdayofweek:='thursday';
5: printdayofweek:='friday';
6: printdayofweek:='saturday'
else exit;
end;
end;
procedure putoutclocktimer;
const
lasthour:word=hrhandsize;
lastminute:word=minhandsize;
lastsecond:word=sechandsize;
lasthundrethofasecond:word=hndthsechandsize;
var
hour,minute,second,hundrethofasecond:word;
txh,txw:integer;
begin
txh:=textheight('d');
txw:=textwidth('d');
setcolor(white);
outtextxy(1,1,' : : . ');
repeat
gettime(hour,minute,second,hundrethofasecond);
if not(lasthour=hour) then begin
puthand(lasthour,hour,hr);
setcolor(white);
bar(0,0,2*txw,txh);
outtextxy(1,1,streng(hour));
lasthour:=hour;
end;
if not(lastminute=minute) then begin
puthand(lastminute,minute,min);
setcolor(white);
bar(3*txw,0,5*txw,txh);
outtextxy(3*txw,1,streng(minute));
lastminute:=minute;
end;
if not(lastsecond=second) then begin
puthand(lastsecond,second,sec);
setcolor(white);
bar(6*txw,0,8*txw,txh);
beep;
outtextxy(6*txw,1,streng(second));
lastsecond:=second;
end;
if not(lasthundrethofasecond=hundrethofasecond) then begin
puthand(lasthundrethofasecond,hundrethofasecond,hndthsec);
setcolor(white);
bar(9*txw,0,11*txw,txh);
outtextxy(9*txw,1,streng(hundrethofasecond));
lasthundrethofasecond:=hundrethofasecond;
end;
until keypressed;
end;
procedure putoutclock;
const
lasthour:word=hrhandsize;
lastminute:word=minhandsize;
lastsecond:word=sechandsize;
lasthundrethofasecond:word=hndthsechandsize;
var
hour,minute,second,hundrethofasecond:word;
begin
repeat
gettime(hour,minute,second,hundrethofasecond);
puthand(lasthundrethofasecond,hundrethofasecond,hndthsec);
lasthundrethofasecond:=hundrethofasecond;
puthand(lastsecond,second,sec);
lastsecond:=second;
puthand(lastminute,minute,min);
lastminute:=minute;
puthand(lasthour,hour,hr);
lasthour:=hour;
until keypressed;
end;
begin
setupgraph;
setupgrid;
putoutclock;
closegraph;
end.